home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Oberon / source / amiga / Utility.mod < prev    next >
Encoding:
Text File  |  1995-06-29  |  23.4 KB  |  776 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: Utility.mod $
  4.   Description: Interface to utility.library
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 3.9 $
  8.       $Author: fjc $
  9.         $Date: 1995/06/04 23:13:14 $
  10.  
  11.   Includes Release 40.15
  12.  
  13.   (C) Copyright 1985-1993 Commodore-Amiga, Inc.
  14.       All Rights Reserved
  15.  
  16.   Oberon-A interface Copyright © 1994-1995, Frank Copeland.
  17.   This file is part of the Oberon-A Interface.
  18.   See Oberon-A.doc for conditions of use and distribution.
  19.  
  20. *************************************************************************)
  21.  
  22. <* STANDARD- *>
  23.  
  24. MODULE [2] Utility;
  25.  
  26. IMPORT SYS := SYSTEM, Kernel, e := Exec, s := Sets;
  27.  
  28.  
  29. (*-- Pointer declarations ---------------------------------------------*)
  30.  
  31. TYPE
  32.  
  33.   ClockDataPtr   * = POINTER TO ClockData;
  34.   HookPtr        * = POINTER TO Hook;
  35.   TagItemPtr     * = POINTER TO TagItem;
  36.   NamedObjectPtr * = POINTER TO NamedObject;
  37.  
  38.  
  39. (*-- Library definitions ----------------------------------------------*)
  40.  
  41. (*
  42. **      $VER: date.h 39.1 (20.1.92)
  43. **
  44. **      Date conversion routines ClockData definition.
  45. *)
  46.  
  47.  
  48. TYPE
  49.  
  50.   ClockData* = RECORD
  51.     sec  * : e.UWORD;
  52.     min  * : e.UWORD;
  53.     hour * : e.UWORD;
  54.     mday * : e.UWORD;
  55.     month* : e.UWORD;
  56.     year * : e.UWORD;
  57.     wday * : e.UWORD;
  58.   END; (* ClockData *)
  59.  
  60.  
  61. (*
  62. **      $VER: hooks.h 39.2 (16.6.93)
  63. **
  64. **      callback hooks
  65. *)
  66.  
  67.  
  68. TYPE
  69.  
  70. (* new standard hook structure *)
  71.   HookFunc * =
  72.     PROCEDURE (hook : HookPtr; object : e.APTR; message : e.APTR) : e.APTR;
  73.   AsmHookFunc * = PROCEDURE () : e.APTR;
  74.  
  75.   (*
  76.     *** Oberon-A Note ***
  77.  
  78.     Oberon-A does not allow register parameters for normal procedures,
  79.     so if you use an AsmHookFunc, you must use SYS.GETREG to access
  80.     the parameters.  e.g:
  81.  
  82.     PROCEDURE MyHookFunc () : e.APTR
  83.       VAR hook : HookPtr; object : e.APTR; message : e.APTR;
  84.     BEGIN
  85.       SYS.GETREG (8, hook);
  86.       SYS.GETREG (10, object);
  87.       SYS.GETREG (9, message);
  88.       ...
  89.     END MyHookFunc;
  90.  
  91.     See the procedure InitHook() for a simpler alternative.
  92.   *)
  93.  
  94.   HookBase *= RECORD (e.MinNodeBase) END;
  95.   HookBasePtr *= POINTER TO HookBase;
  96.  
  97.   Hook* = RECORD (HookBase)
  98.     minNode * : e.MinNode;
  99.     entry   * : AsmHookFunc;   (* assembler entry point        *)
  100.     subEntry* : HookFunc;      (* often HLL entry point        *)
  101.     data    * : e.APTR;        (* owner specific               *)
  102.   END; (* Hook *)
  103.  
  104. (*
  105.  * Hook calling conventions:
  106.  *      A0 - pointer to hook data structure itself
  107.  *      A1 - pointer to parameter structure ("message") typically
  108.  *           beginning with a longword command code, which makes
  109.  *           sense in the context in which the hook is being used.
  110.  *      A2 - Hook specific address data ("object," e.g, GadgetInfo)
  111.  *
  112.  * Control will be passed to the routine hEntry.  For many
  113.  * High-Level Languages (HLL), this will be an assembly language
  114.  * stub which pushes registers on the stack, does other setup,
  115.  * and then calls the function at hSubEntry.
  116.  *
  117.  * The C standard receiving code is:
  118.  * CDispatcher( hook, object, message )
  119.  *     STRUCT Hook     *hook;
  120.  *     APTR             object;
  121.  *     APTR             message;
  122.  *
  123.  * NOTE that register natural order differs from this convention
  124.  * for C parameter order, which is A0,A2,A1.
  125.  *
  126.  * The assembly language stub for "vanilla" C parameter conventions
  127.  * could be:
  128.  
  129.  _hookEntry:
  130.         move.l  a1,-(sp)                ; push message packet pointer
  131.         move.l  a2,-(sp)                ; push object pointer
  132.         move.l  a0,-(sp)                ; push hook pointer
  133.         move.l  h_SubEntry(a0),a0       ; fetch C entry point ...
  134.         jsr     (a0)                    ; ... and call it
  135.         lea     12(sp),sp               ; fix stack
  136.         rts
  137.  
  138.  * with this function as your interface stub, you can write
  139.  * a Hook setup function as:
  140.  
  141.  SetupHook( hook, c_function, userdata )
  142.  STRUCT Hook    *hook;
  143.  ULONG          ( *c_function)();
  144.  VOID           *userdata;
  145.  {
  146.         ULONG   ( *hookEntry)();
  147.  
  148.         hook->h_Entry =         hookEntry;
  149.         hook->h_SubEntry =      c_function;
  150.         hook->h_Data =                  userdata;
  151.  }
  152.  
  153.  * with Lattice C pragmas, you can put the C function in the
  154.  * h_Entry field directly if you declare the function:
  155.  
  156. ULONG __saveds __asm
  157. CDispatcher(    register __a0 STRUCT Hook       *hook,
  158.                 register __a2 VOID              *object,
  159.                 register __a1 ULONG             *message );
  160.  *
  161.  ****)
  162.  
  163.  
  164. (*
  165. **      $VER: tagitem.h 40.1 (19.7.93)
  166. **
  167. **      extended specification mechanism
  168. *)
  169.  
  170. (*****************************************************************************)
  171.  
  172. (* Tags are a general mechanism of extensible data arrays for parameter
  173.  * specification and property inquiry. In practice, tags are used in arrays,
  174.  * or chain of arrays.
  175.  *
  176.  *)
  177.  
  178. TYPE
  179.  
  180.   Tag   * = SYS.LONGWORD;
  181.   TagID * = e.ULONG;
  182.  
  183.   TagItem* = RECORD
  184.     tag*  : TagID;
  185.     data* : Tag;
  186.   END; (* TagItem *)
  187.  
  188.   TagListPtr     * = POINTER TO ARRAY MAX (INTEGER) OF TagItem;
  189.  
  190. (* Types for 'ARRAY OF TagItem' Parameters: *)
  191.  
  192.   Tags1  * = ARRAY  1 OF TagItem;
  193.   Tags2  * = ARRAY  2 OF TagItem;
  194.   Tags3  * = ARRAY  3 OF TagItem;
  195.   Tags4  * = ARRAY  4 OF TagItem;
  196.   Tags5  * = ARRAY  5 OF TagItem;
  197.   Tags6  * = ARRAY  6 OF TagItem;
  198.   Tags7  * = ARRAY  7 OF TagItem;
  199.   Tags8  * = ARRAY  8 OF TagItem;
  200.   Tags9  * = ARRAY  9 OF TagItem;
  201.   Tags10 * = ARRAY 10 OF TagItem;
  202.   Tags11 * = ARRAY 11 OF TagItem;
  203.   Tags12 * = ARRAY 12 OF TagItem;
  204.   Tags13 * = ARRAY 13 OF TagItem;
  205.   Tags14 * = ARRAY 14 OF TagItem;
  206.   Tags15 * = ARRAY 15 OF TagItem;
  207.   Tags16 * = ARRAY 16 OF TagItem;
  208.   Tags17 * = ARRAY 17 OF TagItem;
  209.   Tags18 * = ARRAY 18 OF TagItem;
  210.   Tags19 * = ARRAY 19 OF TagItem;
  211.   Tags20 * = ARRAY 20 OF TagItem;
  212.   Tags21 * = ARRAY 21 OF TagItem;
  213.   Tags22 * = ARRAY 22 OF TagItem;
  214.   Tags23 * = ARRAY 23 OF TagItem;
  215.   Tags24 * = ARRAY 24 OF TagItem;
  216.   Tags25 * = ARRAY 25 OF TagItem;
  217.   Tags26 * = ARRAY 26 OF TagItem;
  218.   Tags27 * = ARRAY 27 OF TagItem;
  219.   Tags28 * = ARRAY 28 OF TagItem;
  220.   Tags29 * = ARRAY 29 OF TagItem;
  221.  
  222. CONST
  223.  
  224. (* constants for Tag.tag, control tag values *)
  225.   done  * = 0;    (* terminates array of TagItems. tiData unused *)
  226.   end   * = done;
  227.   ignore* = 1;    (* ignore this item, not end of array           *)
  228.   more  * = 2;    (* tiData is pointer to another array of TagItems
  229.                    * note that this tag terminates the current array
  230.                    *)
  231.   skip  * = 3;    (* skip this and the next tiData items         *)
  232.  
  233. (* differentiates user tags from control tags *)
  234.   user  * = 80000000H;
  235.  
  236. (* If the tagUser bit is set in a tag number, it tells utility.library that
  237.  * the tag is not a control tag (like tagDone, tagIgnore, tagMore) and is
  238.  * instead an application tag. "USER" means a client of utility.library in
  239.  * general, including system code like Intuition or ASL, it has nothing to do
  240.  * with user code.
  241.  *)
  242.  
  243.  
  244. (*****************************************************************************)
  245.  
  246.  
  247. (* Tag filter logic specifiers for use with FilterTagItems() *)
  248.   filterAnd  * = 0;       (* exclude everything but filter hits   *)
  249.   filterNot  * = 1;       (* exclude only filter hits             *)
  250.  
  251.  
  252. (*****************************************************************************)
  253.  
  254.  
  255. (* Mapping types for use with MapTags() *)
  256.   removeNotFound * = 0;      (* remove tags that aren't in mapList *)
  257.   keepNotFound * = 1;        (* keep tags that aren't in mapList   *)
  258.  
  259.  
  260. (*****************************************************************************)
  261.  
  262.  
  263. (*
  264. **      $VER: name.h 39.5 (11.8.93)
  265. **
  266. **      Namespace definitions
  267. **)
  268.  
  269. (*****************************************************************************)
  270.  
  271. TYPE
  272.  
  273. (* The named object structure *)
  274.   NamedObject * = RECORD
  275.     object * :  e.APTR; (* Your pointer, for whatever you want *)
  276.   END;
  277.  
  278. CONST
  279.  
  280. (* Tags for AllocNamedObject() *)
  281.   nameSpace * = 4000;        (* Tag to define namespace      *)
  282.   userSpace * = 4001;        (* tag to define userspace      *)
  283.   priority * = 4002;         (* tag to define priority       *)
  284.   flags * = 4003;            (* tag to define flags          *)
  285.  
  286. (* Flags for tag anoFlags *)
  287.   nodups * = 0;         (* Default allow duplicates *)
  288.   case * = 1;           (* Default to caseless... *)
  289.  
  290.  
  291. (*****************************************************************************)
  292.  
  293. (*
  294. **      $VER: pack.h 39.3 (10.2.93)
  295. **
  296. **      Control attributes for Pack/UnpackStructureTags()
  297. *)
  298.  
  299. (*****************************************************************************)
  300.  
  301. (* PackTable definition:
  302.  *
  303.  * The PackTable is a simple array of LONGWORDS that are evaluated by
  304.  * PackStructureTags() and UnpackStructureTags().
  305.  *
  306.  * The table contains compressed information such as the tag offset from
  307.  * the base tag. The tag offset has a limited range so the base tag is
  308.  * defined in the first longword.
  309.  *
  310.  * After the first longword, the fields look as follows:
  311.  *
  312.  *      +--------- 1 = signed, 0 = unsigned (for bits, 1=inverted boolean)
  313.  *      |
  314.  *      |  +------ 00 = Pack/Unpack, 10 = Pack, 01 = Unpack, 11 = special
  315.  *      | / \
  316.  *      | | |  +-- 00 = Byte, 01 = Word, 10 = Long, 11 = Bit
  317.  *      | | | / \
  318.  *      | | | | | /----- For bit operations: 1 = TAG_EXISTS is TRUE
  319.  *      | | | | | |
  320.  *      | | | | | | /-------------------- Tag offset from base tag value
  321.  *      | | | | | | |                 \
  322.  *      m n n o o p q q q q q q q q q q r r r s s s s s s s s s s s s s
  323.  *                                      \   | |               |
  324.  *      Bit offset (for bit operations) ----/ |               |
  325.  *                                            \                       |
  326.  *      Offset into data structure -----------------------------------/
  327.  *
  328.  * A -1 longword signifies that the next longword will be a new base tag
  329.  *
  330.  * A 0 longword signifies that it is the end of the pack table.
  331.  *
  332.  * What this implies is that there are only 13-bits of address offset
  333.  * and 10 bits for tag offsets from the base tag.  For most uses this
  334.  * should be enough, but when this is not, either multiple pack tables
  335.  * or a pack table with extra base tags would be able to do the trick.
  336.  * The goal here was to make the tables small and yet flexible enough to
  337.  * handle most cases.
  338.  *)
  339.  
  340. CONST
  341.  
  342.   signed * = 31;
  343.   unpack * = 30;      (* Note that these are active low... *)
  344.   pack   * = 29;      (* Note that these are active low... *)
  345.   exists * = 26;      (* Tag exists bit true flag hack...  *)
  346.  
  347.  
  348. (*****************************************************************************)
  349.  
  350. CONST
  351.  
  352.   ctrlPackUnpack * = 000000000H;
  353.   ctrlPackOnly   * = 040000000H;
  354.   ctrlUnpackOnly * = 020000000H;
  355.  
  356.   ctrlByte       * = 080000000H;
  357.   ctrlWord       * = 088000000H;
  358.   ctrlLong       * = 090000000H;
  359.  
  360.   ctrlUByte      * = 000000000H;
  361.   ctrlUWord      * = 008000000H;
  362.   ctrlULong      * = 010000000H;
  363.  
  364.   ctrlBit        * = 018000000H;
  365.   ctrlFlipBit    * = 098000000H;
  366.  
  367.  
  368. (*
  369.   The following C macros are included for information only.  They may be
  370.   implemented as procedures in the future if there is any demand for it.
  371.  
  372. (*****************************************************************************)
  373.  
  374.  
  375. (* Macros used by the next batch of macros below. Normally, you don't use
  376.  * this batch directly. Then again, some folks are wierd
  377.  *)
  378.  
  379. #define PK_BITNUM1(flg) ((flg) == 0x01 ? 0 : (flg) == 0x02 ? 1 : (flg) == 0x04 ? 2 : (flg) == 0x08 ? 3 : (flg) == 0x10 ? 4 : (flg) == 0x20 ? 5 : (flg) == 0x40 ? 6 : 7)
  380. #define PK_BITNUM2(flg) ((flg < 0x100 ? PK_BITNUM1(flg) : 8+PK_BITNUM1(flg >> 8)))
  381. #define PK_BITNUM(flg) ((flg < 0x10000 ? PK_BITNUM2(flg) : 16+PK_BITNUM2(flg >> 16)))
  382. #define PK_WORDOFFSET(flg) ((flg) < 0x100 ? 1 : 0)
  383. #define PK_LONGOFFSET(flg) ((flg) < 0x100  ? 3 : (flg) < 0x10000 ? 2 : (flg) < 0x1000000 ? 1 : 0)
  384. #define PK_CALCOFFSET(type,field) ((ULONG)(&((struct type * )0)->field))
  385.  
  386.  
  387. (*****************************************************************************)
  388.  
  389.  
  390. (* Some handy dandy macros to easily create pack tables
  391.  *
  392.  * Use PACK_STARTTABLE() at the start of a pack table. You pass it the
  393.  * base tag value that will be handled in the following chunk of the pack
  394.  * table.
  395.  *
  396.  * PACK_ENDTABLE() is used to mark the end of a pack table.
  397.  *
  398.  * PACK_NEWOFFSET() lets you change the base tag value used for subsequent
  399.  * entries in the table
  400.  *
  401.  * PACK_ENTRY() lets you define an entry in the pack table. You pass it the
  402.  * base tag value, the tag of interest, the type of the structure to use,
  403.  * the field name in the structure to affect and control bits (combinations of
  404.  * the various PKCTRL_XXX bits)
  405.  *
  406.  * PACK_BYTEBIT() lets you define a bit-control entry in the pack table. You
  407.  * pass it the same data as PACK_ENTRY, plus the flag bit pattern this tag
  408.  * affects. This macro should be used when the field being affected is byte
  409.  * sized.
  410.  *
  411.  * PACK_WORDBIT() lets you define a bit-control entry in the pack table. You
  412.  * pass it the same data as PACK_ENTRY, plus the flag bit pattern this tag
  413.  * affects. This macro should be used when the field being affected is word
  414.  * sized.
  415.  *
  416.  * PACK_LONGBIT() lets you define a bit-control entry in the pack table. You
  417.  * pass it the same data as PACK_ENTRY, plus the flag bit pattern this tag
  418.  * affects. This macro should be used when the field being affected is longword
  419.  * sized.
  420.  *
  421.  * EXAMPLE:
  422.  *
  423.  *    ULONG packTable[] =
  424.  *    {
  425.  *         PACK_STARTTABLE(GA_Dummy),
  426.  *         PACK_ENTRY(GA_Dummy,GA_Left,Gadget,LeftEdge,PKCTRL_WORD|PKCTRL_PACKUNPACK),
  427.  *         PACK_ENTRY(GA_Dummy,GA_Top,Gadget,TopEdge,PKCTRL_WORD|PKCTRL_PACKUNPACK),
  428.  *         PACK_ENTRY(GA_Dummy,GA_Width,Gadget,Width,PKCTRL_UWORD|PKCTRL_PACKUNPACK),
  429.  *         PACK_ENTRY(GA_Dummy,GA_Height,Gadget,Height,PKCTRL_UWORD|PKCTRL_PACKUNPACK),
  430.  *         PACK_WORDBIT(GA_Dummy,GA_RelVerify,Gadget,Activation,PKCTRL_BIT|PKCTRL_PACKUNPACK,GACT_RELVERIFY)
  431.  *         PACK_ENDTABLE
  432.  *    };
  433.  *)
  434.  
  435. #define PACK_STARTTABLE(tagbase)                           (tagbase)
  436. #define PACK_NEWOFFSET(tagbase)                    (-1L),(tagbase)
  437. #define PACK_ENDTABLE                                      0
  438. #define PACK_ENTRY(tagbase,tag,type,field,control)         (control | ((tag-tagbase) << 16L) | PK_CALCOFFSET(type,field))
  439. #define PACK_BYTEBIT(tagbase,tag,type,field,control,flags) (control | ((tag-tagbase) << 16L) | PK_CALCOFFSET(type,field) | (PK_BITNUM(flags) << 13L))
  440. #define PACK_WORDBIT(tagbase,tag,type,field,control,flags) (control | ((tag-tagbase) << 16L) | (PK_CALCOFFSET(type,field)+PK_WORDOFFSET(flags)) | ((PK_BITNUM(flags)&7) << 13L))
  441. #define PACK_LONGBIT(tagbase,tag,type,field,control,flags) (control | ((tag-tagbase) << 16L) | (PK_CALCOFFSET(type,field)+PK_LONGOFFSET(flags)) | ((PK_BITNUM(flags)&7) << 13L))
  442. *)
  443.  
  444. (*****************************************************************************)
  445.  
  446. (*
  447. **      $VER: utility.h 39.2 (18.9.92)
  448. *)
  449.  
  450. CONST
  451.  
  452.   utilityName * = "utility.library";
  453.  
  454.  
  455. TYPE
  456.  
  457.   UtilityBasePtr* = POINTER TO UtilityBase;
  458.   UtilityBase * = RECORD (e.LibraryBase)
  459.     libNode *  :  e.Library;
  460.     language * :  SHORTINT;
  461.     reserved * :  SHORTINT;
  462.   END;
  463.  
  464.  
  465. (*-- Library Base variable --------------------------------------------*)
  466.  
  467. VAR
  468.  
  469.   base* : UtilityBasePtr;
  470.  
  471.  
  472. (*-- Library Functions ------------------------------------------------*)
  473.  
  474. (*
  475. **      $VER: utility_protos.h 39.12 (10.2.93)
  476. *)
  477.  
  478. (*--- functions in V36 or higher (Release 2.0) ---*)
  479.  
  480. (* *** TagItem FUNCTIONS *** *)
  481.  
  482. PROCEDURE FindTagItemA* [base,-30]
  483.   ( tagVal  [0] : TagID;
  484.     tagList [8] : ARRAY OF TagItem )
  485.   : TagItemPtr;
  486. PROCEDURE FindTagItem* [base,-30]
  487.   ( tagVal  [0] : TagID;
  488.     tagList [8] : TagListPtr )
  489.   : TagItemPtr;
  490. PROCEDURE GetTagDataPA* [base,-36]
  491.   ( tagVal     [0] : TagID;
  492.     defaultVal [1] : e.APTR;
  493.     tagList    [8] : ARRAY OF TagItem )
  494.   : e.APTR;
  495. PROCEDURE GetTagDataA* [base,-36]
  496.   ( tagVal     [0] : TagID;
  497.     defaultVal [1] : e.ULONG;
  498.     tagList    [8] : ARRAY OF TagItem )
  499.   : e.ULONG;
  500. PROCEDURE GetTagDataP* [base,-36]
  501.   ( tagVal     [0] : TagID;
  502.     defaultVal [1] : e.APTR;
  503.     tagList    [8] : TagListPtr )
  504.   : e.APTR;
  505. PROCEDURE GetTagData* [base,-36]
  506.   ( tagVal     [0] : TagID;
  507.     defaultVal [1] : e.ULONG;
  508.     tagList    [8] : TagListPtr )
  509.   : e.ULONG;
  510. PROCEDURE PackBoolTagsA* [base,-42]
  511.   ( initialFlags [0] : s.SET32;
  512.     tagList      [8] : ARRAY OF TagItem;
  513.     boolMap      [9] : ARRAY OF TagItem )
  514.   : s.SET32;
  515. PROCEDURE PackBoolTags* [base,-42]
  516.   ( initialFlags [0] : s.SET32;
  517.     tagList      [8] : TagListPtr;
  518.     boolMap      [9] : ARRAY OF TagItem )
  519.   : s.SET32;
  520. PROCEDURE NextTagItem* [base,-48]
  521.   ( VAR tagListPtr [8] : TagItemPtr )
  522.   : TagItemPtr;
  523. PROCEDURE FilterTagChanges* [base,-54]
  524.   ( newTagList [8] : ARRAY OF TagItem;
  525.     oldTagList [9] : ARRAY OF TagItem;
  526.     apply      [0] : BOOLEAN );
  527. PROCEDURE MapTags* [base,-60]
  528.   ( tagList     [8] : ARRAY OF TagItem;
  529.     mapList     [9] : ARRAY OF TagItem;
  530.     includeMiss [0] : LONGINT );
  531. PROCEDURE AllocateTagItems* [base,-66]
  532.   ( numItems [0] : e.ULONG )
  533.   : TagListPtr;
  534. PROCEDURE CloneTagItemsA* [base,-72]
  535.   ( tagList [8] : ARRAY OF TagItem )
  536.   : TagListPtr;
  537. PROCEDURE CloneTagItems* [base,-72]
  538.   ( tagList [8] : TagListPtr )
  539.   : TagListPtr;
  540. PROCEDURE FreeTagItems* [base,-78]
  541.   ( tagList [8] : TagListPtr );
  542. PROCEDURE RefreshTagItemClones* [base,-84]
  543.   ( cloneList [8] : ARRAY OF TagItem;
  544.     origList  [9] : ARRAY OF TagItem );
  545. PROCEDURE TagInArray* [base,-90]
  546.   ( tagVal   [0] : TagID;
  547.     tagArray [8] : ARRAY OF TagID )
  548.   : BOOLEAN;
  549. PROCEDURE FilterTagItems* [base,-96]
  550.   ( tagList     [8] : ARRAY OF TagItem;
  551.     filterArray [9] : ARRAY OF TagID;
  552.     logic       [0] : LONGINT )
  553.   : LONGINT;
  554.  
  555. (* *** HOOK FUNCTIONS *** * *)
  556.  
  557. PROCEDURE CallHookPkt* [base,-102]
  558.   ( hook        [8] : HookBasePtr;
  559.     object     [10] : e.ADDRESS;
  560.     paramPacket [9] : e.ADDRESS )
  561.   : e.ULONG;
  562.  
  563. (* *** DATE FUNCTIONS *** * *)
  564.  
  565. PROCEDURE Amiga2Date* [base,-120]
  566.   ( amigaTime [0] : e.ULONG;
  567.     VAR date  [8] : ClockData );
  568. PROCEDURE Date2Amiga* [base,-126]
  569.   ( VAR date [8] : ClockData )
  570.   : e.ULONG;
  571. PROCEDURE CheckDate* [base,-132]
  572.   ( VAR date [8] : ClockData )
  573.   : e.ULONG;
  574.  
  575. (* *** 32 BIT MATH FUNCTIONS *** * *)
  576.  
  577. PROCEDURE SMult32* [base,-138]
  578.   ( factor1 [0] : LONGINT;
  579.     factor2 [1] : LONGINT )
  580.   : LONGINT;
  581. PROCEDURE UMult32* [base,-144]
  582.   ( factor1 [0] : e.ULONG;
  583.     factor2 [1] : e.ULONG )
  584.   : e.ULONG;
  585.  
  586. (* NOTE: Quotient:Remainder returned in d0:d1 *)
  587.  
  588. PROCEDURE SDivMod32* [base,-150]
  589.   ( dividend [0] : LONGINT;
  590.     divisor  [1] : LONGINT )
  591.   : LONGINT;
  592. PROCEDURE UDivMod32* [base,-156]
  593.   ( dividend [0] : e.ULONG;
  594.     divisor  [1] : e.ULONG )
  595.   : e.ULONG;
  596.  
  597. (*--- functions in V37 or higher (Release 2.04) ---*)
  598.  
  599. (* *** International string routines *** *)
  600.  
  601. PROCEDURE Stricmp* [base,-162]
  602.   ( string1 [8] : ARRAY OF CHAR;
  603.     string2 [9] : ARRAY OF CHAR )
  604.   : LONGINT;
  605. PROCEDURE Strnicmp* [base,-168]
  606.   ( string1 [8] : ARRAY OF CHAR;
  607.     string2 [9] : ARRAY OF CHAR;
  608.     length  [0] : LONGINT )
  609.   : LONGINT;
  610. PROCEDURE ToUpper* [base,-174]
  611.   ( character [0] : CHAR )
  612.   : CHAR;
  613. PROCEDURE ToLower* [base,-180]
  614.   ( character [0] : CHAR )
  615.   : CHAR;
  616.  
  617. (*--- functions in V39 or higher (Release 3) ---*)
  618.  
  619. (* More tag Item functions *)
  620.  
  621. PROCEDURE ApplyTagChanges* [base,-186]
  622.   ( list [8] : ARRAY OF TagItem; changeList [9] : ARRAY OF TagItem );
  623.  
  624. (* 64 bit integer muliply functions. The results are 64 bit quantities *)
  625. (* returned in D0 and D1 *)
  626.  
  627. PROCEDURE SMult64* [base,-198]
  628.   ( arg1 [0] : LONGINT; arg2 [1] : LONGINT )
  629.   : LONGINT;
  630. PROCEDURE UMult64* [base,-204]
  631.   ( arg1 [0] : e.ULONG; arg2 [1] : e.ULONG )
  632.   : e.ULONG;
  633.  
  634. (* Structure to Tag and Tag to Structure support routines *)
  635.  
  636. PROCEDURE PackStructureTagsA* [base,-210]
  637.   ( pack [8] : e.APTR; packTable [9] : ARRAY  OF e.ULONG;
  638.     tagList [10] : ARRAY OF TagItem )
  639.   : e.ULONG;
  640. PROCEDURE PackStructureTags* [base,-210]
  641.   ( pack [8] : e.APTR; packTable [9] : ARRAY  OF e.ULONG;
  642.     tagList [10] : TagListPtr )
  643.   : e.ULONG;
  644. PROCEDURE UnpackStructureTagsA* [base,-216]
  645.   ( pack [8] : Tag; packTable [9] : ARRAY OF e.ULONG;
  646.     tagList [10] : ARRAY OF TagItem )
  647.   : e.ULONG;
  648. PROCEDURE UnpackStructureTags* [base,-216]
  649.   ( pack [8] : e.APTR; packTable [9] : ARRAY OF e.ULONG;
  650.     tagList [10] : TagListPtr )
  651.   : e.ULONG;
  652.  
  653. (* New, object-oriented NameSpaces *)
  654.  
  655. PROCEDURE AddNamedObject* [base,-222]
  656.   ( nameSpace [8] : NamedObjectPtr; object [9] : NamedObjectPtr )
  657.   : BOOLEAN;
  658. PROCEDURE AllocNamedObjectA* [base,-228]
  659.   ( name [8] : ARRAY OF CHAR; tagList [9] : ARRAY OF TagItem )
  660.   : NamedObjectPtr;
  661. PROCEDURE AllocNamedObject* [base,-228]
  662.   ( name [8] : ARRAY OF CHAR; tagList [9].. : Tag )
  663.   : NamedObjectPtr;
  664. PROCEDURE AttemptRemNamedObject* [base,-234]
  665.   ( object [8] : NamedObjectPtr )
  666.   : BOOLEAN;
  667. PROCEDURE FindNamedObject* [base,-240]
  668.   ( nameSpace [8] : NamedObjectPtr; name [9] : ARRAY OF CHAR;
  669.     lastObject [10] : NamedObjectPtr )
  670.   : NamedObjectPtr;
  671. PROCEDURE FreeNamedObject* [base,-246]
  672.   ( object [8] : NamedObjectPtr );
  673. PROCEDURE NamedObjectName* [base,-252]
  674.   ( object [8] : NamedObjectPtr )
  675.   : e.LSTRPTR;
  676. PROCEDURE ReleaseNamedObject* [base,-258]
  677.   ( object [8] : NamedObjectPtr );
  678. PROCEDURE RemNamedObject* [base,-264]
  679.   ( object [8] : NamedObjectPtr; message [9] : e.MessagePtr );
  680.  
  681. (* Unique ID generator *)
  682.  
  683. PROCEDURE GetUniqueID* [base,-270] ()
  684.   : e.ULONG;
  685.  
  686. (*------------------------------------*)
  687. (*
  688.   This procedure is intended to be installed in the entry field of a
  689.   u.Hook record.  Its purpose is to push the parameters passed to it
  690.   onto the stack and call the procedure installed in the subEntry field.
  691.  
  692.   The parameters are:
  693.  
  694.     hook    : u.HookPtr; (* passed in the A0 register *)
  695.     object  : e.APTR;    (* passed in the A2 register *)
  696.     message : e.APTR;    (* passed in the A1 register *)
  697.  
  698.   Stack checking should be turned off (StackChk-) in all procedures
  699.   installed in Hooks, as they are likely to be running in a non-Oberon
  700.   context.
  701. *)
  702.  
  703. PROCEDURE [0] HookEntry* () : e.APTR;
  704.  
  705. <*$EntryExitCode-*>
  706. BEGIN (* HookEntry *)
  707.   SYS.INLINE (
  708.     48E7H, 3F3EH,                (* MOVEM.L D2-D7,A2-A6,-(A7) *)
  709. <*IF SMALLDATA OR RESIDENT THEN*>  (* Set up the data segment pointer *)
  710.     2868H, 0010H,                (* MOVE.L  $0010(A0), A4     *)
  711. <*END*>
  712.     2F08H,                       (* MOVE.L  A0, -(A7)         *)
  713.     2F0AH,                       (* MOVE.L  A2, -(A7)         *)
  714.     2F09H,                       (* MOVE.L  A1, -(A7)         *)
  715.     2068H, 000CH,                (* MOVE.L  $000C(A0), A0     *)
  716.     4E90H,                       (* JSR     (A0)              *)
  717.     4CDFH, 7CFCH,                (* MOVEM.L (A7)+,D2-D7,A2-A6 *)
  718.     4E75H )                      (* RTS                       *)
  719.   (*
  720.     No RETURN is required, result is already in D0.
  721.     The procedure in subEntry will clean up the parameters on the stack.
  722.   *)
  723. END HookEntry;
  724.  
  725. (*------------------------------------*)
  726. PROCEDURE [0] InitHook * (hook : HookBasePtr; subEntry : HookFunc);
  727.  
  728.   VAR h : HookPtr;
  729.  
  730. BEGIN (* InitHook *)
  731.   h := SYS.VAL (HookPtr, hook);
  732.   h.entry := HookEntry;
  733.   h.subEntry := subEntry;
  734. <*IF SMALLDATA OR RESIDENT THEN*>
  735.   SYS.GETREG (12, h.data)
  736. <*ELSE*>
  737.   h.data := NIL
  738. <*END*>
  739. END InitHook;
  740.  
  741. (*---- useful procedures ---- *)
  742.  
  743. PROCEDURE [0] IgnoreIfNIL * (tagVal: TagID; data: Tag): TagID;
  744. BEGIN
  745.   IF SYS.VAL(e.APTR,data) # NIL THEN RETURN tagVal ELSE RETURN ignore END;
  746. END IgnoreIfNIL;
  747.  
  748. PROCEDURE [0] Bool2Long * (b: BOOLEAN): e.LONGBOOL;
  749. BEGIN
  750.   IF b THEN RETURN e.LTRUE ELSE RETURN e.LFALSE; END;
  751. END Bool2Long;
  752.  
  753. PROCEDURE [0] Long2Bool * (value: LONGINT): BOOLEAN;
  754. BEGIN
  755.   RETURN value # e.LFALSE;
  756. END Long2Bool;
  757.  
  758.  
  759. (*-- Library Base variable --------------------------------------------*)
  760.  
  761. <*$LongVars-*>
  762.  
  763. (*-----------------------------------*)
  764. PROCEDURE* [0] CloseLib (VAR rc : LONGINT);
  765.  
  766. BEGIN (* CloseLib *)
  767.   IF base # NIL THEN e.CloseLibrary (base) END;
  768. END CloseLib;
  769.  
  770. BEGIN
  771.   base := SYS.VAL (UtilityBasePtr,
  772.                    e.OpenLibrary (utilityName, e.libraryMinimum));
  773.   IF base = NIL THEN HALT (100) END;
  774.   Kernel.SetCleanup (CloseLib)
  775. END Utility.
  776.